Automation to Add Appointments to Microsoft Outlook

This article is used to add appointments to Microsoft outlook through automation using VBA coding. We can set many appointments using the following procedure. First we have to create table with corresponding fields name as shown in Fig 1.1

Then create form based on table and add button on header section of form as shown in Fig 1.2. On button event procedure we have to write the code and to enabling the functionality of Microsoft outlook so for this we have to add Microsoft Outlook 14.0 object library by adding as reference.

After writing code on button event we have to open form in form view and click on button. After pressing on button we got a message as shown in Fig 1.3.

Then open the Microsoft outlook and check the appointment option in toolbar and click on it.We Can see the appointment is shown in detailed as shown in Fig 1.4

We can also open the calendar as shown in Fig 1.5 and check the details regarding appointments like as date, time, subject etc. all the things that we provided in Form.

VBA Coding to add appointment to outlook calendar:-

VBA code on button click event has been mentioned below.

Private Sub cmdAddAppt_Click()
On Error GoTo Add_Err
DoCmd.RunCommand acCmdSaveRecord
Dim olobj As Outlook.Application
Dim oloappt As Outlook.AppointmentItem
Dim reecurobj As Outlook.RecurrencePattern
Set olobj = CreateObject("Outlook.Application")
Set oloappt = olobj.CreateItem(olAppointmentItem)
With oloappt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!appt

If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
If Not IsNull(Me!ApptLocation) Then .Location = Me!ApptLocation
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If

Set reecurobj = .GetRecurrencePattern
With reecurobj
.RecurrenceType = olRecursWeekly
.Interval = 1
.PatternStartDate = CDate(Me.ApptDate)
.PatternEndDate = CDate(Me.ApptDate)
End With
.Save
.Close (olSave)
End With

Set oloappt = Nothing
Set olobj = Nothing
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
Exit Sub
Add_Err:
MsgBox "oops error found " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub